home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / vbasic / bmpvws.zip / BMPVIEW.BAS < prev    next >
BASIC Source File  |  1993-09-21  |  7KB  |  227 lines
  1. Option Explicit
  2.  
  3. DefInt A-Z
  4.  
  5. Declare Function UnrealizeObject Lib "GDI" (ByVal hObject As Integer) As Integer
  6. Declare Function SelectObject Lib "GDI" (ByVal hDC As Integer, ByVal hObject As Integer) As Integer
  7. Declare Function GetStockObject Lib "GDI" (ByVal nIndex As Integer) As Integer
  8. Declare Function Rectangle Lib "GDI" (ByVal hDC As Integer, ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
  9. Declare Function SetROP2 Lib "GDI" (ByVal hDC As Integer, ByVal nDrawMode As Integer) As Integer
  10. Declare Function CreateRectRgn Lib "GDI" (ByVal X1 As Integer, ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer) As Integer
  11. Declare Function SelectClipRgn Lib "GDI" (ByVal hDC As Integer, ByVal hRgn As Integer) As Integer
  12. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  13. Declare Function GetDC Lib "User" (ByVal hWnd As Integer) As Integer
  14. Declare Function ReleaseDC Lib "User" (ByVal hWnd As Integer, ByVal hDC As Integer) As Integer
  15. Declare Function DeleteDC Lib "GDI" (ByVal hDC As Integer) As Integer
  16. Declare Function RestoreDC Lib "GDI" (ByVal hDC As Integer, ByVal nSavedDC As Integer) As Integer
  17.  
  18. ' Binary raster ops
  19. Global Const R2_NOTXORPEN = 10
  20.  
  21. ' Stock Logical Objects
  22. Global Const WHITE_BRUSH = 0
  23. Global Const LTGRAY_BRUSH = 1
  24. Global Const GRAY_BRUSH = 2
  25. Global Const DKGRAY_BRUSH = 3
  26. Global Const BLACK_BRUSH = 4
  27. Global Const NULL_BRUSH = 5
  28. Global Const HOLLOW_BRUSH = NULL_BRUSH
  29.  
  30. Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String)
  31. Declare Function GetModuleUsage Lib "Kernel" (ByVal hModule As Integer)
  32. Declare Function GetWindowsDirectory% Lib "Kernel" (ByVal lpBuffer$, ByVal nSize%)
  33. Declare Function GetSystemDirectory% Lib "Kernel" (ByVal lpBuffer$, ByVal nSize%)
  34.  
  35. ' Calculator declarations
  36. Global StartX As Single
  37. Global StartY As Single
  38.  
  39. Global Border As Single
  40. Global TPRatio As Single
  41. Global Bevel As Integer
  42. Global Outline As Integer
  43.  
  44. Global OKToMove As Integer
  45.  
  46. Global PixOffsetX As Integer
  47. Global PixOffsetY As Integer
  48. Global PixStartX As Integer
  49. Global PixStartY As Integer
  50. Global PixPictX As Integer
  51. Global PixPictY As Integer
  52. Global PixX As Integer
  53. Global PixY As Integer
  54.  
  55. Global RgnX1 As Integer
  56. Global RgnY1 As Integer
  57. Global RgnX2 As Integer
  58. Global RgnY2 As Integer
  59.  
  60. '  Data type used by FillRect
  61. Type RECT
  62.     left As Integer
  63.     top As Integer
  64.     right As Integer
  65.     bottom As Integer
  66. End Type
  67.  
  68. '  API Functions used to create pattern brush and draw brush on form
  69. Declare Function CreatePatternBrush Lib "GDI" (ByVal hBitmap As Integer) As Integer
  70. Declare Function FillRect Lib "User" (ByVal hDC As Integer, lpRect As RECT, ByVal hBrush As Integer) As Integer
  71. Declare Function DeleteObject Lib "GDI" (ByVal hObject As Integer) As Integer
  72.  
  73. '  This variable keeps track of which picture shade in picShade
  74. '  control array is being used
  75. Global GShade As Integer
  76.  
  77. Global ViewTitle As String
  78. Global BMPFileName As String
  79. Global ViewCaption As Integer
  80. Global ViewTop As Integer
  81. Global ViewLeft As Integer
  82. Global ViewHeight As Integer
  83. Global ViewWidth As Integer
  84. Global ViewAspect As Double
  85. Global ViewBorder As Integer
  86. Global ViewAllowResize As Integer
  87.  
  88. Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
  89.  
  90. Global Const SWP_NOMOVE = 2
  91. Global Const SWP_NOSIZE = 1
  92. Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  93. Global Const HWND_TOPMOST = -1
  94. Global Const HWND_NOTOPMOST = -2
  95.  
  96. 'Note: This attribute was introduced in Windows, version 3.1, so
  97. 'remember to make a GetVersion() API call to determine whether the
  98. 'application is running under Windows, version 3.1.
  99.  
  100. Global Const PIXEL = 3
  101. Global Const TWIP = 1
  102.  
  103. '----- WindowStates (form)
  104. Global Const NORMAL = 0                ' 0 - Normal
  105. Global Const MINIMIZED = 1             ' 1 - Minimized
  106. Global Const MAXIMIZED = 2             ' 2 - Maximized
  107.  
  108. '---------------------------------------------------------
  109. ' This routine simulates the dragging behavior found in ProgMan.
  110. ' The built-in VB DragDrop routine does not handle clipping
  111. ' properly and yields poor visual results.
  112. '
  113. ' The routine:
  114. '   - Gets a handle to the screen (a DC of Null)
  115. '   - Creates a rectangular region based on the X,Y of the LCD
  116. '   - Sets the Clipping Region to that rectangle
  117. '   - Paints a box on the screen based on the mouse X,Y
  118. '     combined with the applets height and width.
  119. '   - Releases the Windows resources.
  120. '---------------------------------------------------------
  121. '
  122. Sub GhostForm (X As Integer, Y As Integer, h As Integer, W As Integer)
  123.     
  124.     Dim hScreen As Integer
  125.     Dim hRegion As Integer
  126.     Dim tmp As Integer
  127.     Dim hBrush As Integer
  128.     Dim hObjOld As Integer
  129.  
  130.     hScreen = GetDC(0)
  131.     hRegion = CreateRectRgn(RgnX1, RgnY1, RgnX2, RgnY2)
  132.     tmp = SelectClipRgn(hScreen, hRegion)
  133.     hBrush = GetStockObject(NULL_BRUSH)
  134.     hObjOld = SelectObject(hScreen, hBrush)
  135.     tmp = SetROP2(hScreen, R2_NOTXORPEN)
  136.     tmp = Rectangle(hScreen, X, Y, h, W)
  137.     tmp = DeleteObject(hRegion)
  138.     tmp = UnrealizeObject(hScreen)
  139.     hScreen = ReleaseDC(0, hScreen)
  140.  
  141. End Sub
  142.  
  143. Sub ImageLoad ()
  144.     
  145.     BMPView.Image1.Picture = LoadPicture("")
  146.     
  147.     BMPView.Picture1.Picture = LoadPicture(BMPFileName)
  148.     
  149.     ViewAspect = BMPView.Picture1.Width / BMPView.Picture1.Height
  150.     
  151. '   BmpView.Picture1.ScaleMode = PIXEL
  152. '   ViewTitle = "Bitmap Viewer - " & BMPFileName & " (" & Mid$(Str$(BmpView.Picture1.ScaleWidth), 2) & "x" & Mid$(Str$(BmpView.Picture1.ScaleHeight), 2) & ")"
  153. '   ViewTitle = "Bitmap Viewer - Image size (" & Mid$(Str$(BmpView.Picture1.ScaleWidth), 2) & "x" & Mid$(Str$(BmpView.Picture1.ScaleHeight), 2) & ")"
  154. '   BmpView.Picture1.ScaleMode = TWIP
  155.  
  156.     ViewBorder = BMPView.Width - BMPView.ScaleWidth
  157.  
  158.     If (BMPView.Caption = "") Then
  159.         BMPView.Width = BMPView.Picture1.Width + ViewBorder
  160.         BMPView.Height = BMPView.Picture1.Height + ViewBorder
  161.     Else
  162.         BMPView.Width = BMPView.Picture1.Width + ViewBorder
  163.         BMPView.Height = BMPView.Picture1.Height + 324 + ViewBorder
  164.     End If
  165.  
  166.     BMPView.Image1.Width = BMPView.Picture1.Width
  167.     BMPView.Image1.Height = BMPView.Picture1.Height
  168.     
  169.     BMPView.Image1.Picture = BMPView.Picture1.Picture
  170.     BMPView.Picture1.Picture = LoadPicture("")
  171.  
  172. '   If (ViewCaption = True) Then
  173. '       BmpView.Caption = ViewTitle
  174. '   End If
  175.     
  176. End Sub
  177.  
  178. Sub Main ()
  179.     
  180.     Dim tmp As Integer
  181.  
  182.     Screen.MousePointer = 11
  183.     
  184.     TPRatio = Screen.TwipsPerPixelX
  185.  
  186.     Load BMPView
  187.  
  188.     ' Determine the screen bounding region
  189.     RgnX1 = Int(0) / TPRatio
  190.     RgnY1 = Int(0) / TPRatio
  191.     RgnX2 = Int(Screen.Width / TPRatio)
  192.     RgnY2 = Int(Screen.Height / TPRatio)
  193.     
  194.     tmp = DoEvents()
  195.     
  196.     Screen.MousePointer = 0
  197.  
  198.     BMPView.Show
  199.  
  200. End Sub
  201.  
  202. Sub NotTopMost ()
  203.  
  204.     Dim success As Integer
  205.  
  206.     '----- To reset the form XXXX to NON-TOPMOST, use the following code
  207.  
  208.     success% = SetWindowPos(BMPView.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  209.     
  210.     ' success% <> 0 When Successful
  211.  
  212.  
  213. End Sub
  214.  
  215. Sub Topmost ()
  216.     
  217.     Dim success As Integer
  218.     
  219.     '----- To set the form XXXX to TOPMOST, use the following code:
  220.  
  221.     success% = SetWindowPos(BMPView.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  222.     
  223.     ' success% <> 0 When Successful
  224.  
  225. End Sub
  226.  
  227.